COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00007 00003	! dbinit, rtn10,rtn10offset,rstrpos
C00011 00004	! break_at, unbreak_at, breakdebug
C00013 00005	! nocrlf, showtext, textdebug, trapsdebug
C00016 00006	! !!go, p!!sstep,p!!xstep,haltdebug
C00030 00007	! pbreak,debugloop
C00034 ENDMK
C⊗;
ENTRY;
BEGIN "DEBUG"
DEFINE $DEBUG=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

INTEGER NEWPCDBUF;	! new pcode buffer for pcode generated/interpreted
			  while debugging;
INTEGER $COORD,$OFFSET;	! breakpoint coord. and offset;
RPTR(SYMBOL)$WHERE;	! breakpoint proc;


RPTR(EXPR$)PROCEDURE DBEX$2(INTEGER ARG1,INSTR,TXT,PROCREF);
	BEGIN
	RPTR(EXPR$)PTR;RPTR(DBEXPR)DBR;
	INTEGER ARRAY TXTPOS,COORD,TRAPS[1:1];RPTR (BLOCKREC) ARRAY BLOCK[1:1];
	EXPR$:DBEXPR[PTR←EXPR$2(ARG1,instr)]←(DBR←NEW_RECORD(DBEXPR));
	TXTPOS[1]←TXT;COORD[1]←(INSTR ASH 12)+PROCREF; BLOCK[1]←CURBLOCK; 
	MEMORY[LOCATION(txtpos)] ↔ MEMORY[LOCATION(DBEXPR:txtpos[DBR])];
	MEMORY[LOCATION(coord)] ↔ MEMORY[LOCATION(DBEXPR:coord[DBR])];
	MEMORY[LOCATION(block)] ↔ MEMORY[LOCATION(DBEXPR:block[DBR])];
	DBEXPR:#COORD[DBR]←1;
	RETURN(PTR);
	END;

DEFINE #BMARK= '240000;
DEFINE #EMARK= '020000;

INTERNAL RPTR(EXPR$) PROCEDURE MARK(INTEGER INSTR,TXTPOS);
	BEGIN
 	RPTR (EXPR$) ARRAY TEMP[1:3];INTEGER OFF;
	OFF←IF CURPROC THEN IF $COMPILE THEN $SYMOFF ELSE $SYMOFF-1 ELSE 0;
	TEMP[1]← EXPR$2(#BMARK LOR OFF,INSTR);
	TEMP[2]←$$PCODE;
	TEMP[3]←DBEX$2(#EMARK LOR OFF,INSTR,TXTPOS,
			IF REFPROC THEN SYMBOL:OFFSET[REFPROC] ELSE 0);
	REFPROC←NULL_RECORD;
	RETURN ($AAPPEND(TEMP));
	END;

! offset & coord in the same word
0000000000000000000000 00000000000000
coord                  offset	
;
! dbinit, rtn10,rtn10offset,rstrpos;

INTERNAL PROCEDURE DBINIT;
	BEGIN
	! create $$DEBUG from $$pcode, order it with respect to coord numbers,
	  and save pcdpos;
	INTEGER PCSIZE,SSIZE;
	PCSIZE←EXPR$:#BODY[$$PCODE];
	SSIZE←DBEXPR:#COORD[($$DEBUG←EXPR$:DBEXPR[$$PCODE])];
		BEGIN "a"
		INTEGER ARRAY PCDPOS,TXTPOS,COORD,TRAPS[1:SSIZE];
		RPTR(BLOCKREC)ARRAY BLOCK[1:SSIZE];INTEGER I,J,K;
		J←0;
		FOR I←1 STEP 1 UNTIL PCSIZE DO
		   IF EXPR$:BODY[$$PCODE][i]≥ #BMARK THEN PCDPOS[J←J+1]←I;
		IF J≠SSIZE THEN ERROR("DEBUG INIT error");
		MEMORY[LOCATION(PCDPOS)] ↔ MEMORY[LOCATION(DBEXPR:PCDPOS[$$DEBUG])];
	! ordering of txtpos, coord, and block;
		FOR I←1 STEP 1 UNTIL SSIZE DO
			BEGIN
			J← DBEXPR:COORD[$$DEBUG][I] ASH -12;
			TXTPOS[J]←DBEXPR:TXTPOS[$$DEBUG][I];
			BLOCK[J]←DBEXPR:BLOCK[$$DEBUG][I];
			COORD[J]←DBEXPR:COORD[$$DEBUG][I];
			END;
		MEMORY[LOCATION(COORD)] ↔ MEMORY[LOCATION(DBEXPR:COORD[$$DEBUG])];
		MEMORY[LOCATION(TXTPOS)] ↔ MEMORY[LOCATION(DBEXPR:TXTPOS[$$DEBUG])];
		MEMORY[LOCATION(BLOCK)] ↔ MEMORY[LOCATION(DBEXPR:BLOCK[$$DEBUG])];
		MEMORY[LOCATION(TRAPS)] ↔ MEMORY[LOCATION(DBEXPR:TRAPS[$$DEBUG])];
		END "a";
	DBEXPR:BODY[$$DEBUG]←$CLNSAVE;
	IF CURPROC THEN PROC:DBEXPR[SYMBOL:OBJECT[CURPROC]]←$$DEBUG;
	END;

INTERNAL BOOLEAN PROCEDURE RTN10;
	RETURN(!DEBUG AND ¬!!DEBUGGING AND ¬CURPROC
		AND ((DBEXPR:COORD[$$DEBUG][1] LAND '7777) OR
			DBEXPR:#COORD[$$DEBUG]>1));

	! return the restarting position in pcode (in words) relative to the
	beginning of pcode or of procedure pcode;
	! remember to take care of PHALT,offset,coord in front of instruction;
INTEGER PROCEDURE RSTRPOS(RPTR(DBEXPR) DEBG;INTEGER COORD,OFFSET);
	BEGIN
	IF COORD>DBEXPR:#COORD[DEBG] THEN ERROR(":: coordinate too big.");
	IF COORD=1 AND OFFSET THEN ERROR("can't break first instruction of proc.");
	RETURN(DBEXPR:PCDPOS[DEBG][COORD] -1 + (IF OFFSET THEN -4 ELSE 3));
	END;
! break_at, unbreak_at, breakdebug;

RPTR(EXPR$)PROCEDURE BREAK_AT(INTEGER OFFSET,POS11,COORD;RPTR(DBEXPR)DEBG);
	BEGIN
	$$PCODE←EXPR$3(XPBREAK,OFFSET,POS11);
	DBEXPR:TRAPS[DEBG][COORD]←XPBREAK;
	END;

RPTR(EXPR$)PROCEDURE UNBREAK_AT(INTEGER OFFSET,POS11,COORD;RPTR(DBEXPR)DEBG);
	BEGIN
	IF DBEXPR:TRAPS[DEBG][COORD]≠XPBREAK 
	   THEN PRINT("non_existing TRAP",CRLF)
	   ELSE BEGIN 
		DBEXPR:TRAPS[DEBG][COORD]←0;
		$$PCODE←EXPR$3(XUBREAK,OFFSET,POS11);
		END;
	END;

INTERNAL PROCEDURE BREAKDEBUG(BOOLEAN INSERT);
	BEGIN
	INTEGER BPC,OFFSET,POS11;RPTR(SYMBOL)WHERE;rptr(dbexpr)debg;
	WORD_READ("(");if WHERE←PROCNAME_READ then WORD_READ(",");
	BPC←GT_ZERO_READ;WORD_READ(")");
	DEBG← IF WHERE THEN PROC:DBEXPR[SYMBOL:OBJECT[WHERE]] ELSE $$DEBUG;
	IF DEBG=NULL_RECORD THEN ERROR("cannot break "&symbol:pname[where]);
	OFFSET← IF WHERE THEN SYMBOL:OFFSET[WHERE] ELSE 0;
	POS11←RSTRPOS(DEBG, BPC, OFFSET);	! coordinate of the pcode (in word);
	IF BPC > DBEXPR:#COORD[DEBG]
	   THEN ERROR(BPC,": non_existing coordinate !")
	   ELSE IF INSERT THEN	BREAK_AT(OFFSET,POS11,BPC,DEBG)
		ELSE UNBREAK_AT(OFFSET,POS11,BPC,DEBG);
	END;
! nocrlf, showtext, textdebug, trapsdebug;

RECURSIVE STRING PROCEDURE NOCRLF(STRING S);
 RETURN(IF LENGTH(S)<2 THEN S
	ELSE IF EQU(S[1 FOR 2],CRLF) THEN NOCRLF(S[3 TO ∞])
	     ELSE S);


PROCEDURE SHOWTEXT(RPTR(SYMBOL)WHERE;INTEGER LOW, UP_COUNT(0));
	BEGIN
	INTEGER UPPER,IC,maxc;
	RPTR(DBEXPR)DEBG;STRING BODY;
	UPPER← IF LOW ≤ UP_COUNT THEN UP_COUNT
		ELSE IF UP_COUNT=0 THEN LOW ELSE LOW+UP_COUNT-1;
	DEBG← IF WHERE THEN PROC:DBEXPR[SYMBOL:OBJECT[WHERE]] ELSE $$DEBUG;
	IF DEBG=NULL_RECORD THEN ERROR("cannot show text of "&symbol:pname[where]);
	BODY ← DBEXPR:BODY[DEBG];
	IF UPPER > (MAXC←DBEXPR:#COORD[DEBG])
	   THEN	BEGIN
		PRINT(UPPER,":: coordinate is too big.");
		UPPER←MAXC;
		END;
	PRINT(CRLF);
	FOR IC←LOW STEP 1 UNTIL UPPER DO
		PRINT(IF WHERE THEN SYMBOL:PNAME[WHERE]&" " ELSE "",
			  IC,":	",NOCRLF(BODY[DBEXPR:TXTPOS[DEBG][IC]+1
			  TO IF IC≠MAXC THEN DBEXPR:TXTPOS[DEBG][IC+1]
				ELSE ∞]),CRLF)
	END;


INTERNAL PROCEDURE TEXTDEBUG;
	BEGIN
	INTEGER LOW,UPPER;RPTR(SYMBOL) WHERE;
	IF IS_TOKEN("(")
	   THEN BEGIN
		IF WHERE←PROCNAME_READ THEN WORD_READ(",");
		LOW←GT_ZERO_READ; WORD2_READ(",",")","TEXT");
		IF TOKEN="," THEN BEGIN UPPER←GT_ZERO_READ; WORD_READ(")");END 
		   ELSE UPPER←0;
		END
	   ELSE BEGIN LOW←$COORD;UPPER←0;WHERE←$WHERE;END;
	SHOWTEXT(WHERE,LOW,UPPER);
	END;

INTERNAL RECURSIVE PROCEDURE TRAPSDEBUG(RPTR(SYMBOL) WHERE(NULL_RECORD));
	BEGIN
	INTEGER I,N,OFF;RPTR(DBEXPR) DEBG;
	DEBG← IF WHERE THEN PROC:DBEXPR[SYMBOL:OBJECT[WHERE]] ELSE $$DEBUG;
	IF DEBG=NULL_RECORD THEN RETURN;
	N←DBEXPR:#COORD[DEBG];
	FOR I←1 STEP 1 UNTIL N DO
	    BEGIN "TR"
	    IF DBEXPR:TRAPS[DEBG][I] THEN SHOWTEXT(WHERE, I);
	    IF OFF←DBEXPR:COORD[DEBG][I] LAND '7777
		THEN TRAPSDEBUG(CHECKOFF (OFF));
	    END "TR";
	 END;
! !!go, p!!sstep,p!!xstep,haltdebug;

INTERNAL PROCEDURE HALTDEBUG;
	BEGIN
	$$PCODE←EXPR$3(XPHALT,IF CURPROC THEN SYMBOL:OFFSET[CURPROC] ELSE 0,INSTR_N);	
	END;

INTERNAL PROCEDURE RESTARTDEBUG;
	BEGIN
	IF $OFFSET THEN ERROR("cannot RESTART inside a procedure")
	   ELSE $EXECUTE(EXPR$1(XPRESTART));
	END;

PROCEDURE P!!GO(INTEGER COORD,OFFSET);
	$EXECUTE(EXPR$2(XCNTRL,CNTRG));

PROCEDURE P!!STEP(INTEGER COORD,OFFSET);
	$EXECUTE(EXPR$2(XCNTRL,CNTRS));

PROCEDURE P!!GSTEP(INTEGER COORD,OFFSET);
	$EXECUTE(EXPR$2(XCNTRL,CNTRX));
! pbreak,debugloop;

INTERNAL PROCEDURE PBREAK;
	BEGIN
	INTEGER I,OFFSET;
	SETPCDBUF(IF ¬!!DEBUGGING THEN (NEWPCDBUF← OLDPCDBUF+PSIZE*2)
				  ELSE	NEWPCDBUF);
	$OFFSET←GETIN;$COORD←GETIN;
	IF NOT !DEBUG	
	   THEN	PRINT("HALT at : "&CVS($COORD)&
			(if $offset then " offset "&CVS($OFFSET) ELSE "")&CRLF)
	   ELSE SHOWTEXT($where←(IF $OFFSET THEN CHECKOFF($OFFSET) ELSE NULL_RECORD),
			 $COORD);
	DEBUGLOOP;
	END;


INTERNAL PROCEDURE DEBUGLOOP;
	BEGIN
	STRING S;BOOLEAN RSTR;
	!!DEBUGGING←TRUE;RSTR←FALSE;
     DO BEGIN
	PRINT(CRLF,":*: ");ASKUSER; S← _SKIP_ ;
	IF S="G" OR S="g"  THEN BEGIN P!!GO($COORD,$OFFSET);DONE;END;
	IF S="X" OR S="x" 
	   THEN IF ¬!DEBUG
		   THEN BEGIN PRINT("Only ↑G can help you!");CONTINUE;end
	   ELSE	BEGIN P!!GSTEP($COORD,$OFFSET);DONE;END;
	IF S="S" OR S="s"
	   THEN IF ¬!DEBUG
		   THEN BEGIN PRINT("Only ↑G can help you!");CONTINUE;end
	   ELSE	BEGIN P!!STEP($COORD,$OFFSET);DONE;END;
	STOKEN← FALSE;
 	GTOKEN;
	IF  EQU(TOKEN,"!!GO") THEN BEGIN P!!GO($COORD,$OFFSET);DONE;END;
	IF ¬!DEBUG THEN BEGIN PRINT("Only !!go can help you!");CONTINUE;END;
	IF EQU(TOKEN,"!!GSTEP") THEN BEGIN P!!GSTEP($COORD,$OFFSET);DONE;END;
	IF EQU(TOKEN,"!!STEP") THEN BEGIN P!!STEP($COORD,$OFFSET);DONE;END;
	IF EQU(TOKEN,"RESTART") THEN BEGIN RESTARTDEBUG;RSTR←TRUE;DONE;END;
	STOKEN←TRUE;
	PREPARSE;
	CURBLOCK←DBEXPR:BLOCK[IF $WHERE THEN PROC:DBEXPR[symbol:object[$WHERE]]
				 ELSE $$DEBUG][$COORD];
	PARSE;			! parses the instruction;
	CHKESC_I;		! check if escape_I was typed ;
	IF NOT FINAL THEN SEMICOL_READ;
	IF !LINE THEN PRINT(CRLF,"LAST STATEMENT: ",$CLNSAVE);
	END
 UNTIL FALSE;
	IF RSTR THEN RSTR11 ELSE CONTNU11;
	END;

END "DEBUG"